home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / BTH3SRC.ZIP / BTH3.PAS < prev    next >
Pascal/Delphi Source File  |  1996-02-04  |  34KB  |  1,014 lines
  1. (*
  2.    __ $$m. ____ .mm. ______________ .m$$ _______________________________
  3.    ~~ $$$$ ~~~~ $$$$ ~~~~~~~~~~~~~~ $$$$
  4.       $$$$$$$m. $$$$ .m$$$$$m$ .m$$$$$$$ .m$$$$$m.
  5.       $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ee$$$   Beyond The Horizon
  6.       $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$`````         issue #3
  7.       $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$m.         .
  8.       $$$$$$$$' $$$$ `$$$$$$$$ `$$$$$$$$ `$$$$$$$'         :    .
  9.    ________________________________________________________|____:_______
  10.    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  11.  
  12.              coded by : shivan bastard (murray@jax.gulfnet.com)  *)
  13.  
  14.  
  15. {$M 16384,0,65360}  {655360}
  16.  
  17. program Beyond_The_Horizon_Issue_3;
  18.  
  19. uses
  20.   crt,dos,
  21.   mse_tp, {for the music}
  22.   winttt5,
  23. {  fliplay,}
  24.   ansi3;
  25. {  fonts;}
  26.  
  27.  
  28. var
  29.   percent,percent2:real;
  30.   min,n,max,count,i,q,x,y:integer;
  31.   marker,ch,fkey:char;
  32.   skip,found,done:boolean; {skip is auto-scroll,found is use,done is used}
  33.   tf,screen:text;
  34.   s,fn,title,author:string;
  35.   ray:array[1..500] of string[64];
  36.   yy:byte;
  37.  
  38.   SoundCardName : String;
  39.   DMA, IRQ : Byte;
  40.   BaseIO : Word;
  41.   SampleRate : Word;
  42.   DMABuffer : Word;
  43.   Handle : File;
  44.   Header : GDMHeader;
  45.   EMSFlag : Word;
  46.   MusicChannels : Word;
  47.   ChannelCount : Word;
  48.   ExitProgram : Boolean;
  49.  
  50.   sound:boolean; {background sound?}
  51.  
  52. {$I sound.pas}
  53. {$I main.pas}
  54. {$I main2.pas}
  55. {$I reader.pas}
  56. {$I end.pas}
  57.  
  58. {$L intro.obj}
  59. procedure pushead;external;
  60.  
  61.  
  62. procedure tc (i: integer); begin textcolor (i);end;
  63. procedure tb (i: integer); begin textbackground (i);end;
  64. procedure nl; begin writeln;end;
  65.  
  66. procedure d;
  67. begin
  68. delay(100);gotoxy(31,24);
  69. end;
  70.  
  71. procedure waitretrace;assembler; {wait for next vertical retrace}
  72. asm
  73.   mov dx,$3DA
  74.   @V1: in al,dx; test al,8; jz @v1;
  75.   @V2: in al,dx; test al,8; jnz @v2;
  76. end;
  77.  
  78. type
  79.   rgb = record r, g, b : byte; end;
  80.   paltype = array[0..255]of rgb;
  81. var
  82.   j : integer;
  83.   pal : paltype;
  84.  
  85. procedure get_color(var pal : paltype); {save palette}
  86. var
  87.   j : integer;
  88. begin
  89.   port[$3C7] := $00;
  90.   for j:= 0 to 255 do begin
  91.     pal[j].r := port[$3C9];
  92.     pal[j].g := port[$3C9];
  93.     pal[j].b := port[$3C9];
  94.   end;
  95. end;
  96.  
  97. procedure set_intensity(intensity : byte);
  98. var
  99.   j : integer;
  100. begin
  101.   port[$3C8] := $00;
  102.   for j := 0 to 255 do begin
  103.     port[$3C9] := pal[j].r*intensity div 63;
  104.     port[$3C9] := pal[j].g*intensity div 63;
  105.     port[$3C9] := pal[j].b*intensity div 63;
  106.   end;
  107. end;
  108.  
  109. procedure set_to_color(r,g,b,h: integer);
  110. var
  111.   j : integer;
  112. begin
  113.   port[$3C8] := $00;
  114.   for j := 0 to 255 do begin
  115.     port[$3C9] := pal[j].r+(r-pal[j].r)*h div 63;
  116.     port[$3C9] := pal[j].g+(g-pal[j].g)*h div 63;
  117.     port[$3C9] := pal[j].b+(b-pal[j].b)*h div 63;
  118.   end;
  119. end;
  120.  
  121. procedure fade_out(t : integer); {fades from pal to black}
  122. begin
  123.   for j := 63 downto 0 do begin waitretrace; set_intensity(j); delay(t); end;
  124. end;
  125.  
  126. procedure fade_in(t : integer);  {fades from black to pal}
  127. begin
  128.   for j := 0 to 63 do begin waitretrace; set_intensity(j); delay(t); end;
  129. end;
  130.  
  131. procedure flash_in(r,b,g: byte;t : integer); {fades from pal to color}
  132. begin
  133.   for j := 0 to 63 do begin waitretrace; set_to_color(r,b,g,j); delay(t); end;
  134. end;
  135.  
  136. procedure flash_out(r,g,b: byte;t : integer); {fades from color to pal}
  137. begin
  138.   for j := 63 downto 0 do begin waitretrace;set_to_color(r,g,b,j);delay(t);end;
  139. end;
  140.  
  141. procedure introansi;
  142. begin
  143. y:=0;
  144.   for i:=1 to 47 do begin
  145.   move (@pushead^,memw[$b800:y*160],11654); {move-source,destination,size}
  146.   move(memw[$b800:160],memw[$b800:0],11654);
  147.   dec(y);
  148.   delay(3);
  149.   end;
  150. ch:=readkey;
  151. sliderestorescreen(1,up);disposescreen(1);
  152. end;
  153.  
  154.  
  155. procedure drawmain;
  156. begin
  157.   tc(8);
  158.   gotoxy(2,2);write('  Introduction  ');
  159.   gotoxy(2,3);write('    Articles    ');
  160.   gotoxy(2,4);write('   Interviews   ');
  161.   gotoxy(2,5);write('  Pack Reviews  ');
  162.   gotoxy(2,6);write('  WWW Reviews   ');
  163.   gotoxy(2,7);write('  BBS Reviews   ');
  164.   gotoxy(2,8);write('Program Reviews ');
  165.   gotoxy(2,9);write('   Best ANSIs   ');tb(0);
  166. end;
  167.  
  168. procedure showmain;
  169. begin
  170.   tc (11);
  171.   if y=2 then begin gotoxy(2,y);write('  Introduction');end;
  172.   if y=3 then begin gotoxy(2,y);write('    Articles  ');end;
  173.   if y=4 then begin gotoxy(2,y);write('   Interviews ');end;
  174.   if y=5 then begin gotoxy(2,y);write('  Pack Reviews');end;
  175.   if y=6 then begin gotoxy(2,y);write('  WWW Reviews ');end;
  176.   if y=7 then begin gotoxy(2,y);write('  BBS Reviews ');end;
  177.   if y=8 then begin gotoxy(2,y);write('Program Reviews');end;
  178.   if y=9 then begin gotoxy(2,y);write('   Best ANSIs ');end;tb(0);
  179. end;
  180.  
  181. procedure drawintro;
  182. begin
  183.   tc(8);
  184.   gotoxy(52,7);write(' Introduction to Issue #3');
  185.   gotoxy(52,8);write('     Programmers Notes');
  186.   gotoxy(52,9);write('   February Contributors');
  187.   gotoxy(52,10);write(' Contacting the BTH staff ');tb(0);
  188. end;
  189.  
  190. procedure showintro;
  191. begin
  192.   tc (11);
  193.   if y=7 then begin gotoxy(52,y);write(' Introduction to Issue #3');end;
  194.   if y=8 then begin gotoxy(52,y);write('     Programmers Notes');end;
  195.   if y=9 then begin gotoxy(52,y);write('   February Contributors');end;
  196.   if y=10 then begin gotoxy(52,y);write(' Contacting the BTH staff');end;tb(0);
  197. end;
  198.  
  199. procedure drawarticles;
  200. begin
  201.   tc(8);
  202.   gotoxy(52,5);write('    Pushead on Blade');
  203.   gotoxy(52,6);write('  Infiniti Productions   ');
  204.   gotoxy(52,7);write('  DE''s Farewell letter  ');
  205.   gotoxy(52,8);write('    Internet Security  ');
  206.   gotoxy(52,9);write('      Art Payment?  ');
  207.   gotoxy(52,10);write('   BTH Rumor Wall(tm)   ');
  208.   gotoxy(52,11);write('      Emag Reviews  ');
  209.   gotoxy(52,12);write(' History of Forum Hacks');
  210.   gotoxy(52,13);write('      Live with it  ');tb(0);
  211. end;
  212.  
  213. procedure showarticles;
  214. begin
  215.   tc (11);
  216.   if y=5 then begin gotoxy(52,y);write('    Pushead on Blade');end;
  217.   if y=6 then begin gotoxy(52,y);write('  Infiniti Productions');end;
  218.   if y=7 then begin gotoxy(52,y);write('  DE''s farewell letter');end;
  219.   if y=8 then begin gotoxy(52,y);write('    Internet Security');end;
  220.   if y=9 then begin gotoxy(52,y);write('      Art Payment?');end;
  221.   if y=10 then begin gotoxy(52,y);write('   BTH Rumor Wall(tm)');end;
  222.   if y=11 then begin gotoxy(52,y);write('      Emag Reviews');end;
  223.   if y=12 then begin gotoxy(52,y);write(' History of Forum Hacks');end;
  224.   if y=13 then begin gotoxy(52,y);write('      Live with it');end;tb(0);
  225. end;
  226.  
  227. procedure drawinterview;
  228. begin
  229.   tc(8);
  230.   gotoxy(48,7);write(' Interview with Darkened Enmity ');
  231.   gotoxy(48,8);write('      Interview with Somms      ');
  232.   gotoxy(48,9);write('    Interview with Nootropic    ');tb(0);
  233. end;
  234.  
  235. procedure showinterview;
  236. begin
  237.   tc (11);
  238.   if y=7 then begin gotoxy(48,y);write(' Interview with Darkened Enmity ');end;
  239.   if y=8 then begin gotoxy(48,y);write('      Interview with Somms');end;
  240.   if y=9 then begin gotoxy(48,y);write('    Interview with Nootropic');end;tb(0);
  241. end;
  242.  
  243. procedure drawreview;
  244. begin
  245.   tc(8);
  246.   gotoxy(48,7);write(' ACiD - January ''96 (acdu0196)');
  247.   gotoxy(48,8);write(' iCE - December ''95 (ice1295?)');
  248.   gotoxy(48,9);write('Legend - December ''95 (legend05)');
  249.   gotoxy(48,10);write(' Fire - February ''96 (fire0296)');
  250.   gotoxy(48,11);write('  Mop - February ''96 (mop9602)');
  251.   gotoxy(48,12);write('Legend - February ''96 (legend06)');
  252.   tb(0);
  253. end;
  254.  
  255. procedure showreview;
  256. begin
  257.   tc (11);
  258.   if y=7 then begin gotoxy(48,y);write(' ACiD - January ''96 (acdu0196)');end;
  259.   if y=8 then begin gotoxy(48,y);write(' iCE - December ''95 (ice1295?)');end;
  260.   if y=9 then begin gotoxy(48,y);write('Legend - December ''95 (legend05)');end;
  261.   if y=10 then begin gotoxy(48,y);write(' Fire - February ''96 (fire0296)');end;
  262.   if y=11 then begin gotoxy(48,y);write('  Mop - February ''96 (mop9602)');end;
  263.   if y=12 then begin gotoxy(48,y);write('Legend - February ''96 (legend06)');end;
  264.   tb(0);
  265. end;
  266.  
  267. procedure drawpics;
  268. begin
  269.   tc (8);
  270.   gotoxy(50,6);write('#1    Somms - The Regency ');
  271.   gotoxy(50,7);write('#2    Neurotic - Biohazard');
  272.   gotoxy(50,8);write('#3 SG+SA - The Realm of Magic');
  273.   gotoxy(50,9);write('#4    Cold & Ugly - Splat');
  274.   gotoxy(50,10);write('#5     Tremor - Parasite');tb(0);
  275. end;
  276.  
  277. procedure showpics;
  278. begin
  279.   tc(11);
  280.   if y=6 then begin gotoxy(50,y);write('#1    Somms - The Regency    ');end;
  281.   if y=7 then begin gotoxy(50,y);write('#2    Neurotic - Biohazard   ');end;
  282.   if y=8 then begin gotoxy(50,y);write('#3 SG+SA - The Realm of Magic');end;
  283.   if y=9 then begin gotoxy(50,y);write('#4    Cold & Ugly - Splat    ');end;
  284.   if y=10 then begin gotoxy(50,y);write('#5     Tremor - Parasite     ');end;tb(0);
  285. end;
  286.  
  287. Procedure ansiscroll;
  288. begin
  289.   directvideo := false;
  290.   Assign(screen, '');append(screen);clrscr;found:=false;
  291.   reset(tf);
  292.   repeat
  293.      begin readln(tf,s);if s=fn then found:=true;end;
  294.   until found;
  295.   read(tf,ch);
  296.   repeat
  297.   begin
  298.     write(screen,ch);read(tf,ch);
  299.   end;
  300.   until ch=marker;
  301.   gotoxy(30,24);tc(1);write('[                      ]');gotoxy(31,24);tc(15);
  302.   close(tf);
  303.   repeat
  304.    write(' Expand Your Horizons ');d;
  305.    write('Expand Your Horizons  ');d;
  306.    write('xpand Your Horizons  E');d;
  307.    write('pand Your Horizons  Ex');d;
  308.    write('and Your Horizons  Exp');d;
  309.    write('nd Your Horizons  Expa');d;
  310.    write('d Your Horizons  Expan');d;
  311.    write(' Your Horizons  Expand');d;
  312.    write('Your Horizons  Expand ');D;
  313.    write('our Horizons  Expand Y');d;
  314.    write('ur Horizons  Expand Yo');d;
  315.    write('r Horizons  Expand You');d;
  316.    write(' Horizons  Expand Your');d;
  317.    write('Horizons  Expand Your ');d;
  318.    write('orizons  Expand Your H');d;
  319.    write('rizons  Expand Your Ho');d;
  320.    write('izons  Expand Your Hor');d;
  321.    write('zons  Expand Your Hori');d;
  322.    write('ons  Expand Your Horiz');d;
  323.    write('ns  Expand Your Horizo');d;
  324.    write('s  Expand Your Horizon');d;
  325.    write('  Expand Your Horizons');d;
  326.  
  327.   until keypressed;memw[$0000:$041a]:=memw[$0000:$041c];
  328.   sliderestorescreen(1,up);disposescreen(1);
  329. end;
  330.  
  331. procedure wait;assembler; {wait for next vertical retrace}
  332. asm
  333.   mov dx,$3DA
  334.   @V1: in al,dx; test al,8; jz @v1;
  335.   @V2: in al,dx; test al,8; jnz @v2;
  336. end;
  337.  
  338. Procedure scroller;
  339.  
  340.  procedure clear;
  341.  begin
  342.  for i:=1 to 500 do
  343.   ray[i]:=' ';
  344.  end;
  345.  
  346.  procedure scroll;
  347.   begin
  348.     if q<1 then q:=1;
  349.     x:=9;y:=6;tb(1);tc(15);
  350.     for i:=1 to 15 do
  351.     begin
  352.     gotoxy(x,y);write('                                                                ');
  353.     gotoxy(x,y);writeln(ray[q]);y:=y+1;q:=q+1;
  354.     end;
  355.     tc(15);tb(7);gotoxy(65,23);write('[',q,'/',max,']   ');
  356.     tb(0);tc(15);tb(1);
  357.     percent:=100 * (q / max);
  358.     percent2:=percent/(100/7);
  359.  
  360. {*  alright this is the messiest part of my code. all this does is
  361.     make a scroll bar on the side, its not very efficient, but it works
  362.     could've probably made some weird complicated loop, but chose instead to
  363.     go with the cut n' paste method heh. =) *}
  364.  
  365.     if percent2 > 0 then begin if percent2 <2 then begin
  366.       tc(15);tb(1);gotoxy(77,10);write('▓');
  367.       gotoxy(77,11);tc(1);tb(7);write('▓');
  368.       gotoxy(77,12);tc(1);tb(7);write('▓');
  369.       gotoxy(77,13);tc(1);tb(7);write('▓');
  370.       gotoxy(77,14);tc(1);tb(7);write('▓');
  371.       gotoxy(77,15);tc(1);tb(7);write('▓');
  372.       gotoxy(77,16);tc(1);tb(7);write('▓');end;end;
  373.     if percent2 > 2 then begin if percent2 <3 then begin
  374.       tc(15);tb(1);gotoxy(77,11);write('▓');
  375.       gotoxy(77,10);tc(1);tb(7);write('▓');
  376.       gotoxy(77,12);tc(1);tb(7);write('▓');
  377.       gotoxy(77,13);tc(1);tb(7);write('▓');
  378.       gotoxy(77,14);tc(1);tb(7);write('▓');
  379.       gotoxy(77,15);tc(1);tb(7);write('▓');
  380.       gotoxy(77,16);tc(1);tb(7);write('▓');end;end;
  381.     if percent2 > 3 then begin if percent2 < 4 then begin
  382.       tc(15);tb(1);gotoxy(77,12);write('▓');
  383.       gotoxy(77,10);tc(1);tb(7);write('▓');
  384.       gotoxy(77,11);tc(1);tb(7);write('▓');
  385.       gotoxy(77,13);tc(1);tb(7);write('▓');
  386.       gotoxy(77,14);tc(1);tb(7);write('▓');
  387.       gotoxy(77,15);tc(1);tb(7);write('▓');
  388.       gotoxy(77,16);tc(1);tb(7);write('▓');end;end;
  389.     if percent2 > 4 then begin if percent2<5 then begin
  390.       tc(15);tb(1);gotoxy(77,13);write('▓');
  391.       gotoxy(77,10);tc(1);tb(7);write('▓');
  392.       gotoxy(77,11);tc(1);tb(7);write('▓');
  393.       gotoxy(77,12);tc(1);tb(7);write('▓');
  394.       gotoxy(77,14);tc(1);tb(7);write('▓');
  395.       gotoxy(77,15);tc(1);tb(7);write('▓');
  396.       gotoxy(77,16);tc(1);tb(7);write('▓');end;end;
  397.     if percent2 > 5 then begin if percent2<6 then begin
  398.       tc(15);tb(1);gotoxy(77,14);write('▓');
  399.       gotoxy(77,10);tc(1);tb(7);write('▓');
  400.       gotoxy(77,11);tc(1);tb(7);write('▓');
  401.       gotoxy(77,12);tc(1);tb(7);write('▓');
  402.       gotoxy(77,13);tc(1);tb(7);write('▓');
  403.       gotoxy(77,15);tc(1);tb(7);write('▓');
  404.       gotoxy(77,16);tc(1);tb(7);write('▓');end;end;
  405.     if percent2 > 6 then begin if percent2<7 then begin
  406.       tc(15);tb(1);gotoxy(77,15);write('▓');
  407.       gotoxy(77,10);tc(1);tb(7);write('▓');
  408.       gotoxy(77,11);tc(1);tb(7);write('▓');
  409.       gotoxy(77,12);tc(1);tb(7);write('▓');
  410.       gotoxy(77,13);tc(1);tb(7);write('▓');
  411.       gotoxy(77,14);tc(1);tb(7);write('▓');
  412.       gotoxy(77,16);tc(1);tb(7);write('▓');end;end;
  413.     if percent2 >= 7 then begin tc(15);tb(1);gotoxy(77,16);write('▓');
  414.       gotoxy(77,10);tc(1);tb(7);write('▓');
  415.       gotoxy(77,11);tc(1);tb(7);write('▓');
  416.       gotoxy(77,12);tc(1);tb(7);write('▓');
  417.       gotoxy(77,13);tc(1);tb(7);write('▓');
  418.       gotoxy(77,14);tc(1);tb(7);write('▓');
  419.       gotoxy(77,15);tc(1);tb(7);write('▓');end;
  420.       tb(0);
  421.   end;
  422.  
  423. begin
  424. fade_out(20);readeransi;fade_in(1);Flash_Out(100,16,32,20);
  425. tb(7);tc(0);gotoxy(12,2);write(title);gotoxy(12,3);write(author);tb(0);tc(15);
  426. done:=false;
  427. reset(tf);
  428.  
  429. repeat
  430. readln(tf,s);
  431. until s=fn;
  432. readln(tf,max);
  433. for i:=1 to max do readln(tf,ray[i]);
  434.   close(tf);max:=max+2;if max<16 then max:=16;
  435.   q:=1;scroll;
  436.   repeat
  437.     while not keypressed do begin
  438. {    if b2 > 0 then begin write(b2);b2:=b2-2;g2:=g2+2;wait;pal2(1);end;
  439.     if g2 > 0 then begin g2:=g2-1;b2:=b2+1;wait;pal2(1);end;}
  440.     end;
  441.     ch:=upcase(readkey);
  442.     if max > 16 then begin
  443.       (* down scroll *)
  444.       if ((ch=#80) and (q<max)) then
  445.       begin
  446.       q:=q-14;scroll;
  447.       end;
  448.       (* up scroll *)
  449.       if ch=#72 then
  450.       begin
  451.       q:=q-16;scroll;
  452.       end;
  453.       (* page down *)
  454.       if ((ch=#81) and ((q+14)<max)) then
  455.       begin
  456.       scroll;
  457.       end;
  458.       (* page up *)
  459.       if ch=#73 then
  460.       begin
  461.       q:=q-30;scroll;
  462.       end;
  463.       (* home key *)
  464.       if ch=#71 then
  465.       begin
  466.       tc(1);tb(7);for n:=11 to 16 do begin
  467.       gotoxy(77,n);write('▓');end;
  468.       q:=1;scroll;
  469.       end;
  470.       (* end key *)
  471.       if ch=#79 then
  472.       begin
  473.       tc(1);tb(7);for n:=10 to 15 do begin
  474.       gotoxy(77,n);write('▓');end;
  475.       q:=max-15;scroll;
  476.       end;
  477.     end;
  478.     (* exit reader *)
  479.     if ch=#27 then done:=true;
  480.   until done;
  481.   done:=false;
  482.   clear;
  483.   sliderestorescreen(1,up);disposescreen(1);
  484. end;
  485.  
  486. procedure introduction;
  487. begin
  488.   mainansi2;
  489.   drawintro;showintro;count:=1;
  490.   repeat
  491.   if keypressed=true then begin ch := upcase (readkey);
  492.     (*=-  when the hit [esc]  -=*)
  493.     if ch = #27 then done := true;
  494.     if ch = #0 then begin ch := readkey;
  495.       (*=-  Up arror/cursor crap  -=*)
  496.       if ch = #72 then begin if wherey <> 7 then begin
  497.       dec (y);drawintro;showintro;end;end;
  498.       (*=- Down arror/cursor crap -=*)
  499.       if ch = #80 then begin if wherey <> 10 then begin
  500.         inc(y);drawintro;showintro;end;end;end;
  501.     (*=-  when they hit enter  -=*)
  502.     if ch = #13 then begin
  503.     if y=7 then begin savescreen(1);fn:='intro.bth';title:='BTH Issue #3 Introduction';author:='Mindcrime';
  504.     scroller;y:=7;drawintro;showintro;continue;end;
  505.     if y=8 then begin savescreen(1);fn:='notes.bth';title:='Programmers Notes';author:='shivan bastard';
  506.     scroller;y:=8;drawintro;showintro;continue;end;
  507.     if y=9 then begin savescreen(1);fn:='credits.bth';title:='BTH Credits';author:='BTH Staff';
  508.     scroller;y:=9;drawintro;showintro;continue;end;
  509.     if y=10 then begin savescreen(1);fn:='contact.bth';title:='How to contribute';author:='BTH Staff';
  510.     scroller;y:=10;drawintro;showintro;continue;end;
  511.   end;
  512.   end;
  513.   until done;tb (0);done:=false;mainansi;
  514. end;
  515.  
  516. procedure articles;
  517. begin
  518.   mainansi2;
  519.   drawarticles;showarticles;count:=1;
  520.   repeat
  521.   if keypressed=true then begin ch := upcase (readkey);
  522.     (*=-  when the hit [esc]  -=*)
  523.     if ch = #27 then done := true;
  524.     if ch = #0 then begin ch := readkey;
  525.       (*=-  Up arror/cursor crap  -=*)
  526.       if ch = #72 then begin if wherey <> 5 then begin
  527.       dec (y);drawarticles;showarticles;end;end;
  528.       (*=- Down arror/cursor crap -=*)
  529.       if ch = #80 then begin if wherey <> 13 then begin
  530.         inc(y);drawarticles;showarticles;end;end;end;
  531.     (*=-  when they hit enter  -=*)
  532.     if ch = #13 then begin
  533.     if y=5 then begin savescreen(1);fn:='article.1';title:='Pushead on Blade';author:='Pushead';
  534.     scroller;y:=5;drawarticles;showarticles;continue;end;
  535.     if y=6 then begin savescreen(1);fn:='article.2';title:='Infiniti Productions';author:='Pushead';
  536.     scroller;y:=6;drawarticles;showarticles;continue;end;
  537.     if y=7 then begin savescreen(1);fn:='article.3';title:='Farewell Letter';author:='Darkened Enmity';
  538.     scroller;y:=7;drawarticles;showarticles;continue;end;
  539.     if y=8 then begin savescreen(1);fn:='article.4';title:='The Internet';author:='Darklord';
  540.     scroller;y:=8;drawarticles;showarticles;continue;end;
  541.     if y=9 then begin savescreen(1);fn:='article.5';title:='Payment for Art';author:='Shivan Bastard';
  542.     scroller;y:=9;drawarticles;showarticles;continue;end;
  543.     if y=10 then begin savescreen(1);fn:='article.6';title:='Rumor Wall';author:='Shivan Bastard + MindCrime';
  544.     scroller;y:=10;drawarticles;showarticles;continue;end;
  545.     if y=11 then begin savescreen(1);fn:='article.7';title:='Electronic Magazines';author:='MindCrime';
  546.     scroller;y:=11;drawarticles;showarticles;continue;end;
  547.     if y=12 then begin savescreen(1);fn:='article.8';title:='History of Forum Hacks';author:='Meltdown';
  548.     scroller;y:=12;drawarticles;showarticles;continue;end;
  549.     if y=13 then begin savescreen(1);fn:='article.9';title:='Live with it!';author:='Bedlam';
  550.     scroller;y:=13;drawarticles;showarticles;continue;end;
  551.   end;end;
  552.   until done;tb (0);done:=false;mainansi;
  553. end;
  554.  
  555. procedure interviews;
  556. begin
  557.   MAINANSI2;
  558.   drawinterview;showinterview;count:=1;
  559.   repeat
  560.   if keypressed=true then begin ch := upcase (readkey);
  561.     (*=-  when the hit [esc]  -=*)
  562.     if ch = #27 then done := true;
  563.     if ch = #0 then begin ch := readkey;
  564.       (*=-  Up arror/cursor crap  -=*)
  565.       if ch = #72 then begin if wherey <> 7 then begin
  566.       dec (y);drawinterview;showinterview;end;end;
  567.       (*=- Down arror/cursor crap -=*)
  568.       if ch = #80 then begin if wherey <> 9 then begin
  569.         inc(y);drawinterview;showinterview;end;end;end;
  570.     (*=-  when they hit enter  -=*)
  571.     if ch = #13 then begin
  572.     if y=7 then begin savescreen(1);fn:='iv.1';title:='Interview with Darkened Enmity';author:='Shivan Bastard';
  573.     scroller;y:=7;drawinterview;showinterview;continue;end;
  574.     if y=8 then begin savescreen(1);fn:='iv.2';title:='Interview with Somms';author:='Shivan Bastard';
  575.     scroller;y:=8;drawinterview;showinterview;continue;end;
  576.     if y=9 then begin savescreen(1);fn:='iv.3';title:='Interview with Nootropic';author:='MindCrime';
  577.     scroller;y:=9;drawinterview;showinterview;continue;end;
  578.   end;end;
  579.   until done;tb (0);done:=false;mainansi;
  580. end;
  581.  
  582. procedure reviews;
  583. begin
  584.   mainansi2;
  585.   drawreview;showreview;count:=1;
  586.   repeat
  587.   if keypressed=true then begin ch := upcase (readkey);
  588.     (*=-  when the hit [esc]  -=*)
  589.     if ch = #27 then done := true;
  590.     if ch = #0 then begin ch := readkey;
  591.       (*=-  Up arror/cursor crap  -=*)
  592.       if ch = #72 then begin if wherey <> 7 then begin
  593.       dec (y);drawreview;showreview;end;end;
  594.       (*=- Down arror/cursor crap -=*)
  595.       if ch = #80 then begin if wherey <> 12 then begin
  596.         inc(y);drawreview;showreview;end;end;end;
  597.     (*=-  when they hit enter  -=*)
  598.     if ch = #13 then begin
  599.     if y=7 then begin savescreen(1);fn:='review.1';title:='ACiD 12/95';author:='MindCrime';
  600.     scroller;y:=7;drawreview;showreview;continue;end;
  601.     if y=8 then begin savescreen(1);fn:='review.2';title:='iCE 11/95';author:='Shivan Bastard';
  602.     scroller;y:=8;drawreview;showreview;continue;end;
  603.     if y=9 then begin savescreen(1);fn:='review.3';title:='Legend 12/95';author:='Shivan Bastard';
  604.     scroller;y:=9;drawreview;showreview;continue;end;
  605.     if y=10 then begin savescreen(1);fn:='review.4';title:='Fire 2/96';author:='MindCrime';
  606.     scroller;y:=10;drawreview;showreview;continue;end;
  607.     if y=11 then begin savescreen(1);fn:='review.5';title:='Mop 2/96';author:='MindCrime';
  608.     scroller;y:=11;drawreview;showreview;continue;end;
  609.     if y=12 then begin savescreen(1);fn:='review.6';title:='Legend 2/96';author:='MindCrime';
  610.     scroller;y:=12;drawreview;showreview;continue;end;
  611.   end;end;
  612.   until done;tb (0);done:=false;mainansi;
  613. end;
  614.  
  615. procedure pics;
  616. begin
  617.   mainansi2;
  618.   drawpics;showpics;count:=1;
  619.   repeat
  620.   if keypressed=true then begin ch := upcase (readkey);
  621.     (*=-  when the hit [esc]  -=*)
  622.     if ch = #27 then done := true;
  623.     if ch = #0 then begin ch := readkey;
  624.       (*=-  Up arror/cursor crap  -=*)
  625.       if ch = #72 then begin if wherey <> 6 then begin
  626.       dec (y);drawpics;showpics;end;end;
  627.       (*=- Down arror/cursor crap -=*)
  628.       if ch = #80 then begin if wherey <> 10 then begin
  629.         inc(y);drawpics;showpics;end;end;end;
  630.     (*=-  when they hit enter  -=*)
  631.     if ch = #13 then begin
  632.     if y=6 then begin savescreen(1);fn:='ansi.1';marker:=#1;
  633.     ansiscroll;y:=6;drawpics;showpics;continue;end;
  634.     if y=7 then begin savescreen(1);fn:='ansi.2';marker:=#2;
  635.     ansiscroll;y:=7;drawpics;showpics;continue;end;
  636.     if y=8 then begin savescreen(1);fn:='ansi.3';marker:=#3;
  637.     ansiscroll;y:=8;drawpics;showpics;continue;end;
  638.     if y=9 then begin savescreen(1);fn:='ansi.4';marker:=#4;
  639.     ansiscroll;y:=9;drawpics;showpics;continue;end;
  640.     if y=10 then begin savescreen(1);fn:='ansi.5';marker:=#5;
  641.     ansiscroll;y:=10;drawpics;showpics;continue;end;
  642.   end;end;
  643.   until done;tb (0);done:=false;
  644.   mainansi;
  645. end;
  646.  
  647. procedure mainmenu;
  648.   begin
  649.   memw[$0000:$041a]:=memw[$0000:$041c];
  650.   drawmain;showmain;count:=1;
  651.   done:=false;
  652.   repeat
  653.   if keypressed=true then begin ch := upcase (readkey);
  654.     (*=-  when the hit [esc]  -=*)
  655.     if ch = #27 then done := true;
  656.     if ch = #0 then begin ch := readkey;
  657.       (*=-  Up arror/cursor crap  -=*)
  658.       if ch = #72 then begin if wherey <> 2 then begin
  659.       dec (y);drawmain;showmain;end;end;
  660.       (*=- Down arror/cursor crap -=*)
  661.       if ch = #80 then begin if wherey <> 9 then begin
  662.         inc(y);drawmain;showmain;end;end;end;
  663.     (*=-  when they hit enter  -=*)
  664.     if ch = #13 then begin
  665.     if y=2 then begin y:=7;introduction;y:=2;drawmain;showmain;continue;end;
  666.     if y=3 then begin y:=5;articles;y:=3;drawmain;showmain;continue;end;
  667.     if y=4 then begin y:=7;interviews;y:=4;drawmain;showmain;continue;end;
  668.     if y=5 then begin y:=7;reviews;y:=5;drawmain;showmain;continue;end;
  669.     if y=6 then begin y:=2;savescreen(1);fn:='www.rev';title:='Web Site Reviews';Author:='MindCrime';
  670.     scroller;y:=6;drawmain;showmain;continue;end;
  671.     if y=7 then begin y:=2;savescreen(1);fn:='bbs.rev';title:='BBS Reviews';Author:='Shivan Bastard';
  672.     scroller;y:=7;drawmain;showmain;continue;end;
  673.     if y=8 then begin y:=2;savescreen(1);fn:='program.rev';title:='Art Viewer Reviews';Author:='Shivan Bastard';
  674.     scroller;y:=8;drawmain;showmain;continue;end;
  675.     if y=9 then begin y:=6;pics;y:=9;drawmain;showmain;continue;end;
  676.     end;
  677.     end;
  678.   until done;tb(0);
  679. end;
  680.  
  681.  
  682. {*
  683. **
  684. **    Sound Procedures
  685. **    Copyright 1993-95 Edward Schlunder
  686. **
  687. *}
  688.  
  689.  
  690. Procedure EndProg(ErrorString : String);
  691. { Prints the error string and Halts the program }
  692.  
  693. Begin
  694.   Writeln;
  695.   Writeln(ErrorString);
  696.   If IOResult <> 0 then Close(Handle);
  697.   Halt(0);
  698. End;
  699.  
  700. procedure drawsc1;
  701. begin
  702. tc(7);tb(0);
  703. gotoxy(6,15);write('   Gravis Ultrasound   ');
  704. gotoxy(6,16);write('   SoundBlaster 1.0    ');
  705. gotoxy(6,17);write('   SoundBlaster 2.0    ');
  706. gotoxy(6,18);write('   SoundBlaster Pro    ');
  707. gotoxy(6,19);write('   SoundBlaster 16     ');
  708. gotoxy(6,20);write('   Pro Audio Spectrum  ');
  709. gotoxy(6,21);write('   No Sound            ');
  710. end;
  711.  
  712. procedure showsc1;
  713. begin
  714. tc(15);tb(1);gotoxy(6,y);
  715. if y = 15 then write('   Gravis Ultrasound   ');
  716. if y = 16 then write('   SoundBlaster 1.0    ');
  717. if y = 17 then write('   SoundBlaster 2.0    ');
  718. if y = 18 then write('   SoundBlaster Pro    ');
  719. if y = 19 then write('   SoundBlaster 16     ');
  720. if y = 20 then write('   Pro Audio Spectrum  ');
  721. if y = 21 then write('   No Sound            ');tb(0);
  722. end;
  723.  
  724. Procedure GetSoundCardName;
  725.  
  726. Begin
  727.   y:=15;done:=false;
  728.   repeat
  729.   drawsc1;showsc1;
  730.   ch:=upcase(readkey);
  731.     if ch=#13 then begin
  732.       if y=15 then SoundCardName := 'GUS.MSE';
  733.       if y=16 then SoundCardName := 'SB1X.MSE';
  734.       if y=17 then SoundCardName := 'SB2X.MSE';
  735.       if y=18 then SoundCardName := 'SBPRO.MSE';
  736.       if y=19 then SoundCardName := 'SB16.MSE';
  737.       if y=20 then SoundCardName := 'PAS.MSE';
  738.       if y=21 then sound:=false;
  739.       done:=true;
  740.       end;
  741.     if ch=#0 then begin fkey:=upcase(readkey);
  742.       if ((fkey=#80) and (y<>21)) then inc(y);
  743.       if ((fkey=#72) and (y<>15)) then dec(y);
  744.       end;
  745.     if ch=#27 then begin gotoxy(1,24);tc(15);tb(0);writeln('BTH Issue 3 Sound Card Detection Aborted');halt;end;
  746.   until done;
  747. End;
  748.  
  749. procedure drawsc2;
  750. begin
  751. tc(7);tb(0);
  752. gotoxy(6,15);write('   IRQ 2               ');
  753. gotoxy(6,16);write('   IRQ 3               ');
  754. gotoxy(6,17);write('   IRQ 5               ');
  755. gotoxy(6,18);write('   IRQ 7               ');
  756. gotoxy(6,19);write('   IRQ 11              ');
  757. gotoxy(6,20);write('   IRQ 12              ');
  758. gotoxy(6,21);write('   Autodetect          ');
  759. end;
  760.  
  761. procedure showsc2;
  762. begin
  763. tc(15);tb(1);gotoxy(6,y);
  764. if y = 15 then write('   IRQ 2        ');
  765. if y = 16 then write('   IRQ 3        ');
  766. if y = 17 then write('   IRQ 5        ');
  767. if y = 18 then write('   IRQ 7        ');
  768. if y = 19 then write('   IRQ 11       ');
  769. if y = 20 then write('   IRQ 12       ');
  770. if y = 21 then write('   Autodetect   ');tb(0);
  771. end;
  772.  
  773.  
  774. Procedure GetIRQNumber;
  775.  
  776. begin
  777.   tc(15);tb(0);
  778.   gotoxy(6,13);write('IRQ Setting       ');gotoxy(25,13);write('2');
  779.   y:=21;done:=false;
  780.   repeat
  781.   drawsc2;showsc2;
  782.   ch:=upcase(readkey);
  783.     if ch=#13 then begin
  784.       if y=15 then irq := 2;
  785.       if y=16 then irq := 3;
  786.       if y=17 then irq := 5;
  787.       if y=18 then irq := 7;
  788.       if y=19 then irq := 11;
  789.       if y=20 then irq := 12;
  790.       if y=21 then irq := $FF;
  791.       done:=true;
  792.       end;
  793.     if ch=#0 then begin fkey:=upcase(readkey);
  794.       if ((fkey=#80) and (y<>21)) then inc(y);
  795.       if ((fkey=#72) and (y<>15)) then dec(y);
  796.       end;
  797.     if ch=#27 then begin gotoxy(1,24);tc(15);tb(0);writeln('BTH Issue 3 Sound Card Detection Aborted');halt;end;
  798.   until done;
  799. End;
  800.  
  801.  
  802. procedure drawsc3;
  803. begin
  804. tc(7);tb(0);
  805. gotoxy(6,15);write('   DMA Channel 1       ');
  806. gotoxy(6,16);write('   DMA Channel 2       ');
  807. gotoxy(6,17);write('   DMA Channel 3       ');
  808. gotoxy(6,18);write('   DMA Channel 5       ');
  809. gotoxy(6,19);write('   Autodetect          ');
  810. gotoxy(6,20);write('                       ');
  811. gotoxy(6,21);write('                       ');
  812. end;
  813.  
  814. procedure showsc3;
  815. begin
  816. tc(15);tb(1);gotoxy(6,y);
  817. if y = 15 then write('   DMA Channel 1');
  818. if y = 16 then write('   DMA Channel 2');
  819. if y = 17 then write('   DMA Channel 3');
  820. if y = 18 then write('   DMA Channel 5');
  821. if y = 19 then write('   Autodetect   ');
  822. if y = 20 then write('                ');
  823. if y = 21 then write('                ');tb(0);
  824. end;
  825.  
  826.  
  827. Procedure GetDMAChannel;
  828.  
  829. Begin
  830.   tc(15);tb(0);
  831.   gotoxy(6,13);write('DMA Channel       ');gotoxy(25,13);write('3');
  832.   y:=19;done:=false;
  833.   repeat
  834.   drawsc3;showsc3;
  835.   ch:=upcase(readkey);
  836.     if ch=#13 then begin
  837.       if y=15 then dma := 1;
  838.       if y=16 then dma := 2;
  839.       if y=17 then dma := 3;
  840.       if y=18 then dma := 5;
  841.       if y=19 then dma := $FF;
  842.       done:=true;
  843.       end;
  844.     if ch=#0 then begin fkey:=upcase(readkey);
  845.       if ((fkey=#80) and (y<>19)) then inc(y);
  846.       if ((fkey=#72) and (y<>15)) then dec(y);
  847.       end;
  848.     if ch=#27 then begin gotoxy(1,24);tc(15);tb(0);writeln('BTH Issue 3 Sound Card Detection Aborted');halt;end;
  849.   until done;
  850.  
  851. End;
  852.  
  853.  
  854. procedure drawsc4;
  855. begin
  856. tc(7);tb(0);
  857. gotoxy(6,15);write('   210h                ');
  858. gotoxy(6,16);write('   220h                ');
  859. gotoxy(6,17);write('   230h                ');
  860. gotoxy(6,18);write('   240h                ');
  861. gotoxy(6,19);write('   250h                ');
  862. gotoxy(6,20);write('   260h                ');
  863. gotoxy(6,21);write('   Autodetect          ');
  864. end;
  865.  
  866. procedure showsc4;
  867. begin
  868. tc(15);tb(1);gotoxy(6,y);
  869. if y = 15 then write('   210h         ');
  870. if y = 16 then write('   220h         ');
  871. if y = 17 then write('   230h         ');
  872. if y = 18 then write('   240h         ');
  873. if y = 19 then write('   250h         ');
  874. if y = 20 then write('   260h         ');
  875. if y = 21 then write('   Autodetect   ');tb(0);
  876. end;
  877.  
  878. Procedure GetBaseIO;
  879.  
  880. Begin
  881.  
  882.   tc(15);tb(0);
  883.   gotoxy(6,13);write('Base IO Address');gotoxy(25,13);write('4');
  884.   y:=21;done:=false;
  885.   repeat
  886.   drawsc4;showsc4;
  887.   ch:=upcase(readkey);
  888.     if ch=#13 then begin
  889.       if y=15 then baseio := $210;
  890.       if y=16 then baseio := $220;
  891.       if y=17 then baseio := $230;
  892.       if y=18 then baseio := $240;
  893.       if y=19 then baseio := $250;
  894.       if y=20 then baseio := $260;
  895.       if y=21 then baseio := $FFFF;
  896.  
  897.       done:=true;
  898.       end;
  899.     if ch=#0 then begin fkey:=upcase(readkey);
  900.       if ((fkey=#80) and (y<>21)) then inc(y);
  901.       if ((fkey=#72) and (y<>15)) then dec(y);
  902.       end;
  903.     if ch=#27 then begin gotoxy(1,24);tc(15);tb(0);writeln('BTH Issue 3 Sound Card Detection Aborted');halt;end;
  904.   until done;
  905.  
  906. End;
  907.  
  908.  
  909. Function ToHex(Num : Word) : String;
  910. { Converts a decimal number to Hexidecimal }
  911.  
  912. Const
  913.   HexChars : String = '0123456789ABCDEF';
  914.  
  915. Var
  916.   Temp : String;
  917.  
  918. Begin
  919.   Temp := '';
  920.   Temp := Temp + HexChars[((Num Shr 8) And 15) + 1];
  921.   Temp := Temp + HexChars[((Num Shr 4) And 15) + 1];
  922.   Temp := Temp + HexChars[((Num Shr 0) And 15) + 1];
  923.   ToHex := Temp + 'h';
  924. End;
  925.  
  926.  
  927.  
  928. Begin
  929.   tc(15);tb(0);
  930.   assign(tf,'bth3.dat');
  931.   {$I-}
  932.   reset(tf);
  933.   {$I+}
  934.   if ioresult <> 0 then
  935.     begin
  936.       writeln('BTH Data File : BTH3.DAT not found! ');
  937.       halt;
  938.     end;
  939.  
  940.   sound:=true;
  941.   setupansi;
  942.   getsoundcardname;
  943.   if sound then begin
  944.   getirqnumber;
  945.   getdmachannel;
  946.   getbaseio;
  947.   samplerate:=45;
  948.   dmabuffer:=4096;
  949.  
  950.   Case LoadMSE(SoundCardName, 0, SampleRate, DMABuffer, BaseIO, IRQ, DMA) of
  951.     1 : EndProg('Base I/O address autodetection failure');
  952.     2 : EndProg('IRQ level autodetection failure');
  953.     3 : EndProg('DMA channel autodetection failure');
  954.     4 : EndProg('DMA channel not supported');
  955.     6 : EndProg('Sound device does not respond');
  956.     7 : EndProg('Memory control blocks destroyed');
  957.     8 : EndProg('Insufficient memory for mixing buffers');
  958.     9 : EndProg('Insufficient memory for MSE file');
  959.     10: EndProg('MSE has invalid identification string');
  960.     11: EndProg('MSE disk read failure');
  961.     12: EndProg('MVSOUND.SYS not loaded');
  962.   End;
  963.  
  964.   ExitProc := @FreeMSE;              { Call FreeMSE on abnormal program end }
  965.   If EMSExist                      { Check for EMS }
  966.     Then EMSFlag := 1              { Yes, EMS exists, so use it }
  967.     Else EMSFlag := 0;             { EMS does not exist }
  968.  
  969. {$I-}                              { Turn off I/O checking }
  970.   Assign(Handle, 'bth3.gdm');   { Open the file for loading }
  971.   Reset(Handle);
  972. {$I+}                              { Turn I/O checking back on }
  973.   If IOResult <> 0 Then
  974.      EndProg('You deleted BTH3.GDM dumbass!');{ File not found, exit program }
  975.  
  976.   Case LoadGDM(Handle, 0, EMSFlag, Header) of
  977.     1 : EndProg('Module is corrupt');
  978.     2 : EndProg('Could not autodetect module type (N/A)');
  979.     3 : EndProg('Bad file format ID string');
  980.     4 : EndProg('Insufficient memory to load module');
  981.     5 : EndProg('Can not unpack samples');
  982.     6 : EndProg('AdLib instruments not supported');
  983.   End;
  984.   Close(Handle);
  985.  
  986.   MusicChannels := 0;            { Calculate the number of channels in song }
  987.   For ChannelCount := 1 to 32 do
  988.     Begin
  989.       If Header.PanMap[ChannelCount] <> $FF
  990.         Then MusicChannels := MusicChannels + 1;
  991.     End;
  992.   SampleRate := StartOutput(MusicChannels, 0);
  993.   StartMusic;
  994.   gotoxy(6,23);tc(7);
  995.   Writeln('Port: ', ToHex(BaseIO),'  IRQ: ',IRQ,'  DMA: ',DMA);
  996.   end;
  997.  
  998.   get_color(pal);fade_out(30);
  999.  
  1000. {  introansi;readkey;}
  1001.   memw[$0000:$041a]:=memw[$0000:$041c];
  1002.   offcursor;clrscr;fade_in(0);
  1003.   introansi;
  1004.   y:=2;mainansi;fade_in(20);mainmenu;
  1005.   fade_out(20);clrscr;
  1006.   if sound then begin
  1007.     StopMusic;
  1008.     StopOutput;
  1009.     UnloadModule;
  1010.     FreeMse;
  1011.   end;
  1012.   endansi;
  1013.   fade_in(30);gotoxy(1,24);oncursor;
  1014. End.